home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok03.lha / IFFtoCode / Sources / IFFtoSprIm.mod < prev    next >
Text File  |  1993-08-15  |  10KB  |  307 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    IFFtoSprIm.mod
  3.     :Author.     Pit Burkhardt
  4.     :Address.    Stettinerstraße 25, D-7030 Böblingen
  5.     :Phone.      (please let me sleep peacefully)
  6.     :Shortcut.   [pit]
  7.     :Version.    0.2
  8.     :Date.       13.06.88
  9.     :Copyright.  PD
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga
  12.     :Imports.    LoadIFF.mod [fbs]
  13.     :UpDate.     none
  14.     :Contents.   Umwandlung von IFF-Bildern in M2-Source-Code für SpritesImages.
  15.     :Remark.     Updated Version of V0.1
  16. ---------------------------------------------------------------------------*)
  17. MODULE IFFtoSprIm;
  18.  
  19. FROM SYSTEM IMPORT     ADR, ADDRESS, SHIFT, BITSET, LONGSET, CAST;
  20.  
  21. FROM Exec IMPORT    UByte;
  22.  
  23. FROM Intuition IMPORT     ScreenPtr,WindowPtr,CloseScreen,DisplayBeep;
  24.  
  25. FROM Arguments IMPORT     NumArgs,GetArg;
  26.  
  27. FROM Arts IMPORT    TermProcedure,Assert;    
  28.  
  29. FROM IFFLoad  IMPORT     ReadILBM,ReadILBMFlags,ReadILBMFlagSet,IFFInfo;
  30.  
  31. FROM Graphics IMPORT     RastPortPtr,BitMapPtr;
  32.  
  33. FROM InOut IMPORT    WriteString,WriteLn,WriteHex,WriteInt,OpenOutput,
  34.             CloseOutput;
  35.  
  36. FROM Strings IMPORT    Length,Copy,Insert;
  37.  
  38. VAR    MyScreen,
  39.     MyOldScreen    :ScreenPtr;
  40.     MyWindow    :WindowPtr;
  41.       Name,PtrName,
  42.         CurrentName,
  43.         CONSTName    :ARRAY[0..79] OF CHAR;
  44.         length,i,
  45.         Eingabe,
  46.         Durchgang    :INTEGER;
  47.       Error        :BOOLEAN;
  48.       len        :LONGINT;
  49.       BitMaps        :ARRAY[0..5] OF ADDRESS;
  50.         ScLineLength,
  51.         LineLength,
  52.         Plane        :LONGINT;
  53.         Pictheight,
  54.         Pictdepth,
  55.         Pictwidth    :LONGINT;
  56.         AnzEingaben    :INTEGER;
  57.       RP        :RastPortPtr;
  58.       BM        :BitMapPtr;
  59.         HeaderDone    :BOOLEAN;
  60.         mehrDim        :BOOLEAN;
  61.         AnzElem,Ae,
  62.         AnzZiff        :LONGINT;
  63.  
  64. PROCEDURE CleanUp;
  65.  BEGIN
  66.   IF MyScreen<>NIL THEN CloseScreen(MyScreen) END;
  67.  END CleanUp;
  68.  
  69.  
  70. PROCEDURE PointerName(Name:ARRAY OF CHAR;VAR PName:ARRAY OF CHAR);
  71.  VAR     l    :INTEGER;    
  72.  BEGIN
  73.   l:=Length(Name);
  74.   Copy(PName,Name,0,79);
  75.   Insert(PName,l,"Ptr");
  76.  END PointerName;
  77.  
  78.  
  79. PROCEDURE WritePlaneDat(BitMaps:ARRAY OF ADDRESS;Pictwidth,Pictheight,
  80.             Pictdepth,ScLineLength:LONGINT;
  81.                         Name,PtrName,CName:ARRAY OF CHAR);
  82.   VAR            Location    :POINTER TO UByte;
  83.                 Plane        :CARDINAL;
  84.                 Line,
  85.                 ByteStep,Bstep,
  86.                 Bs        :LONGINT;
  87.           Index       :CARDINAL;
  88.                 ItemsPerLine    :LONGINT;    
  89.  
  90. PROCEDURE WriteHeader(VAR Done:BOOLEAN);    (* Schreibt die Deklarationen *)
  91.  BEGIN   
  92.    
  93.    WriteLn;
  94.    WriteString("          (* -------> DEFINITION MODULE <-------- *)"); 
  95.    WriteLn;
  96.    WriteLn;
  97.    WriteString("DEFINITION MODULE "); WriteString(Name); WriteString(";");
  98.    WriteLn; WriteLn;
  99.    WriteString("FROM SYSTEM IMPORT      WORD;");
  100.    WriteLn; WriteLn;
  101.    WriteString("FROM Heap IMPORT        AllocMem;");
  102.    WriteLn; WriteLn;
  103.    
  104.    WriteString("   (* Img enthält Sprite(!) Image Daten *)"); 
  105.    WriteLn; 
  106.    WriteLn; 
  107.    WriteString("TYPE    Img=RECORD"); WriteLn; 
  108.    WriteString("          Pos:ARRAY [0..1] OF WORD;"); WriteLn;
  109.    WriteString("          Dat:ARRAY [0.."); WriteInt(AnzElem,AnzZiff);
  110.    WriteString("] OF WORD;"); WriteLn;
  111.    WriteString("          Add:ARRAY [0..1] OF WORD;"); WriteLn;
  112.    WriteString("        END;"); WriteLn;
  113.    WriteLn; WriteLn;
  114.    
  115.    IF mehrDim THEN
  116.     WriteString("CONST   ");
  117.     FOR i:=1 TO AnzEingaben DO
  118.       GetArg(i,CONSTName,length);
  119.       WriteString(CONSTName); WriteString("=");WriteInt(i-1,3);WriteString(";");
  120.       WriteLn; WriteString("        ");
  121.     END;
  122.     WriteLn; WriteLn;
  123.    END;
  124.    
  125.    WriteString("VAR     "); WriteString(Name); WriteString("height  :INTEGER;");
  126.    WriteLn;        
  127.    
  128.    WriteString("        "); WriteString(PtrName); 
  129.    IF mehrDim THEN
  130.      WriteString("     :ARRAY [0.."); WriteInt(AnzEingaben-1,3);
  131.      WriteString("] OF POINTER TO Img;"); WriteLn;
  132.      WriteLn; WriteLn;
  133.    ELSE
  134.      WriteString("     :POINTER TO Img;");
  135.      WriteLn; WriteLn;        
  136.    END;
  137.    WriteString("END "); WriteString(Name); WriteString(".");
  138.    WriteLn; WriteLn; 
  139.    
  140.    
  141.    WriteString("          (* -------> IMPLEMENTATION MODULE <-------- *)"); 
  142.    WriteLn;
  143.    WriteLn;  
  144.    WriteString("IMPLEMENTATION MODULE "); WriteString(Name); WriteString(";");
  145.    WriteLn; WriteLn;
  146.    WriteString("FROM SYSTEM IMPORT      WORD;");
  147.    WriteLn; WriteLn;
  148.    WriteString("FROM Heap IMPORT        AllocMem;");
  149.    WriteLn; WriteLn;
  150.    
  151.    IF mehrDim THEN
  152.        WriteString("VAR     i   :INTEGER;");
  153.        WriteLn; WriteLn;        
  154.    END;
  155.    WriteLn; WriteLn;        
  156.    WriteString("BEGIN   (* MAIN *)");
  157.    WriteLn; WriteLn;         
  158.    
  159.    IF mehrDim THEN
  160.      WriteString("FOR i:=0 TO ");
  161.      WriteInt(AnzEingaben-1,3); WriteString("  DO"); WriteLn;
  162.      WriteString("  AllocMem(");     WriteString(PtrName); 
  163.      WriteString("[i],SIZE(");       WriteString(PtrName); 
  164.      WriteString("[i]^),TRUE);");     WriteLn;
  165.      WriteString("  "); WriteString(PtrName); WriteString("[i]^.Pos[0]:=0; ");
  166.      WriteLn;
  167.      WriteString("  "); WriteString(PtrName); WriteString("[i]^.Pos[1]:=0;");
  168.      WriteLn;
  169.      WriteString("  "); WriteString(PtrName); WriteString("[i]^.Add[0]:=0;");
  170.      WriteLn;
  171.      WriteString("  "); WriteString(PtrName); WriteString("[i]^.Add[0]:=0;");
  172.      WriteLn;
  173.      WriteString("END;"); 
  174.    ELSE
  175.      WriteString("AllocMem(");     WriteString(PtrName); 
  176.      WriteString(",SIZE(");       WriteString(PtrName); 
  177.      WriteString("^),TRUE);");     WriteLn;
  178.      WriteString(PtrName); WriteString("^.Pos[0]:=0; ");
  179.      WriteLn;
  180.      WriteString(PtrName); WriteString("^.Pos[1]:=0;");
  181.      WriteLn;
  182.      WriteString(PtrName); WriteString("^.Add[0]:=0;");
  183.      WriteLn;
  184.      WriteString(PtrName); WriteString("^.Add[0]:=0;");
  185.      WriteLn;
  186.    END;
  187.    
  188.    WriteLn; 
  189.    WriteString(Name); WriteString("height"); WriteString(":=");
  190.    WriteInt(Pictheight,3); WriteString(";");
  191.    WriteLn;
  192.    Done:=TRUE;         
  193.  END WriteHeader;   
  194.  
  195. (* *********************  WritePlaneDat ********************* *)
  196.  
  197.   BEGIN                         
  198.    AnzElem:=Pictwidth*Pictdepth*Pictheight DIV 2-1;
  199.    Ae:=AnzElem;
  200.    AnzZiff:=1;
  201.    WHILE Ae>10 DO;
  202.      Ae:=Ae DIV 10;
  203.      AnzZiff:=AnzZiff+1;    (* Anzahl der Ziffern des größten Indexes *)  
  204.    END;
  205.    
  206.    ItemsPerLine:=2;
  207.    
  208.    IF NOT HeaderDone THEN 
  209.      WriteHeader(HeaderDone);
  210.    END;
  211.    
  212.    WriteLn; WriteLn;
  213.    WriteString("WITH "); WriteString(PtrName);
  214.    IF mehrDim THEN
  215.      WriteString("["); WriteString(CName); WriteString("]");
  216.    END;
  217.    WriteString("^ DO         (* "); 
  218.    WriteString(CName); WriteString(" *)"); 
  219.    WriteLn;  
  220.    WriteLn;  
  221.    
  222.    Index:=0;
  223.    ItemsPerLine:=ItemsPerLine*2;        (*  2 Bytes per Item     *)
  224.    (*Pictwidth:=Pictwidth*2;*)
  225.    WriteString("   (* Plane 1 *)     (* Plane 2 *)"); WriteLn; 
  226.    FOR Line := 0 TO Pictheight-1 DO
  227.         FOR Plane := 0 TO 1 DO            (*  2 Planes in 1 Zeile    *)
  228.               WriteString("  Dat[");        
  229.              WriteInt(Index,AnzZiff);
  230.               Index:=Index+1;
  231.               WriteString("]:=0");
  232.               FOR Bs:=0 TO 1 DO            (*  Schreibt ein WORD    *)
  233.                  Location:=ADDRESS(BitMaps[Plane]+ ScLineLength*Line+Bs);
  234.                  WriteHex(Location^,2);        (*  Hex-Wert schreiben     *)
  235.           END; (*FOR Bs*)                
  236.               WriteString("H;");
  237.               Bstep:=Bstep+2;
  238.         END; (*FOR Plane*)
  239.         WriteString("  (*"); WriteInt(Line+1,2); WriteString("*)");
  240.         WriteLn;
  241.    END; (*FOR Line*)
  242.  END WritePlaneDat;
  243.          
  244.                
  245. BEGIN (* MAIN *)
  246.   
  247.   Name:="Img";
  248.   
  249.   TermProcedure(CleanUp);
  250.   HeaderDone:=FALSE;
  251.   AnzEingaben:=NumArgs();
  252.   IF AnzEingaben>1 THEN mehrDim:=TRUE END;
  253.   WriteLn;
  254.   WriteString("IFFtoSprIm Version 0.2 by Pit Burkhardt"); 
  255.   WriteLn;WriteLn;
  256.   IF AnzEingaben=0 THEN
  257.     WriteString("Sorry, can't work - no Input!"); WriteLn;WriteLn;
  258.     WriteString("From CLI: Name IFF-file(s) as option."); WriteLn;WriteLn;
  259.     WriteString("From Workbench: <SHIFT>-klick IFF-file(s),"); WriteLn;
  260.     WriteString("then <SHIFT>-doubleklick IFFtoSprIm"); WriteLn; WriteLn;
  261.   ELSE
  262.     WriteString("Enter Name of Source-file to be generated or press <RETURN>"); 
  263.     WriteLn;
  264.     OpenOutput(" ");
  265.     PointerName(Name,PtrName);
  266.     FOR Eingabe:=1 TO AnzEingaben DO
  267.         Durchgang:=Eingabe-1;
  268.         GetArg(Eingabe,CurrentName,length);
  269.       MyOldScreen:=MyScreen;
  270.         IF MyOldScreen<>NIL THEN CloseScreen(MyOldScreen) END;
  271.         Error:=ReadILBM(CurrentName,ReadILBMFlagSet{visible},MyScreen,MyWindow);
  272.       Assert((Error),ADR("Fehler beim Laden des ILBM-Files"));
  273.       Pictdepth:=IFFInfo.BMHD.depth;
  274.       Pictheight:=IFFInfo.BMHD.height;
  275.       Pictwidth:=IFFInfo.BMHD.width;
  276.       IF Pictwidth>16 THEN
  277.           WriteString("(* Brush zu breit, wurde abgeschnitten!!! *)"); WriteLn;
  278.       ELSIF Pictwidth<16 THEN
  279.           WriteString("(* Brush zu schmal, wurde verbreitert *)"); WriteLn;
  280.         END;
  281.         Pictwidth:=16;
  282.         LineLength := SHIFT(Pictwidth,-3);    (*ergibt Zeilenlänge in Bytes*)
  283.       IF LineLength*8<Pictwidth THEN
  284.           WriteString("(* Brushbreite gegenüber IFF geändert! *)"); WriteLn;
  285.           LineLength:=LineLength+2;
  286.       END;
  287.       ScLineLength:= SHIFT(MyScreen^.width,-3);
  288.       RP := ADR(MyScreen^.rastPort);
  289.       BM := RP^.bitMap;
  290.       FOR i:=0 TO Pictdepth-1 DO
  291.           BitMaps[i] := BM^.planes[i];
  292.       END;
  293.   
  294.       WritePlaneDat(BitMaps,LineLength,Pictheight,Pictdepth,ScLineLength,
  295.                       Name,PtrName,CurrentName);
  296.         WriteString("END; ");
  297.         WriteLn; 
  298.     END; (*FOR i*)
  299.     WriteString("END "); WriteString(Name); WriteString(".");
  300.     WriteLn;
  301.     CloseOutput; 
  302.     WriteLn;
  303.     WriteString("Thanks! It was a pleasure to work with you ..."); 
  304.     WriteLn;
  305.   END; (*IF*)
  306. END IFFtoSprIm.
  307.